//@+leo-ver=5-thin
//@+node:sonam.20180318222306.1: * @file FracData.pas
//@+at
// 時輪歷算中的數據大多采用多位分數（也就是繁分數）表示，每一位的分母又根據不同的
// 數據計算需要而选定，例如《總滙如意寶》中計算太阳运行的中日、定日等數據時就采用
// 五位分數，每一位对应的分母从高位開始分别是27,60,60,6,67，而計算中曜、定曜等數據
// 時則使用六位分數等。
// 
// 这里为了定義歷算中将要用到的分數數據类，先定義一个通用的n位繁分數數據类TCompFraction，
// 然后在此基礎上就可以很容易地定義計算曜時使用的數據類型TPlanetData和計算日時的TSunData、
// 計算月時的TMoonData。
// 
//@@c
unit FracData;

//@+others
//@+node:sonam.20180318223124.1: ** 類聲明
//@@c
interface

uses PlanetCycle;

Const
    // 計算五曜時使用的數據類型之最后一位的分母
    PlanetWheel : array[0..5-1] of Integer = (229,361,5383,8797,749);  

Type
//@+node:sonam.20180318200656.1: *3* TCompFraction類聲明
//@@c
    TIntArray = array of Integer;
    TCompFraction = class(TObject)	// 在Object Pascal中无法不使用TObject作为基类
    public
        constructor Create(n : Integer); overload;
        constructor Create(f : TCompFraction); overload;

    protected
        fData : Array of Int64;		// 每一位的分子
        fWheel : Array of Integer;	// 每一位的分母
        function GetData(i: Integer) : Int64;	// 都使用从一開始的下标
        procedure SetData(i: Integer; d: Int64);
        function GetWheel(i: Integer) : Integer;
    public
        function Length() : Integer;

        procedure SetWheel(i, w: Integer);
        procedure SetAllData(d: Integer); overload;
        procedure SetAllWheel(a : array of Integer);

        property data[Index: Integer] : Int64 read GetData write SetData;
        property wheel[Index: Integer] : Integer read GetWheel;

        function Equal(frac: TCompFraction) : Boolean;
        function GreatEqual(frac: TCompFraction) : Boolean;
        procedure Add(frac: TCompFraction);
        procedure Sub(frac: TCompFraction);
        procedure Multiply(frac: TCompFraction); overload;
        procedure Multiply(n: Int64); overload;
        procedure Divide(dv: Integer; start: Integer = 1);
        procedure Calibrate();

        function Text() : String;
	end;
//@+node:sonam.20180318200706.1: *3* TWeekData類聲明
//@@c
    TWeekData = class(TCompFraction)
	public
        constructor Create(a: array of Integer);
    end;
//@+node:sonam.20180318200721.1: *3* TSunData類聲明
//@@c
    TSunData = class(TCompFraction)
    public
        constructor Create(a: array of Integer);
    end;
//@+node:sonam.20180318200728.1: *3* TMoonData類聲明
//@@c
	TMoonData = class(TCompFraction)
	public
        constructor Create(a: array of Integer);
	end;
//@+node:sonam.20180318200743.1: *3* TPlanetData類聲明
//@@c
	TPlanetData = class(TCompFraction)
	public
        constructor Create(p: Planet; a: array of Integer);
 	end;
//@+node:sonam.20180318200821.1: *3* TSunPlanetData類聲明
//@@c
	TSunPlanetData = class(TCompFraction)
	public
        constructor Create(a: array of Integer);
	end;
//@+node:sonam.20180318200848.1: *3* TGenPlanetData類聲明
    TGenPlanetData = class(TCompFraction)
    public
        constructor Create(p : Planet; f : TCompFraction); overload;
        constructor Create(p : Planet; a : array of Integer); overload;
    end;
    
    TGenPlanetData6 = class(TCompFraction)
    public
        constructor Create(f : TGenPlanetData);
    end;
//@+node:sonam.20180319122618.1: *3* 幾個幫助函數
//@@c
// 一个Factory模式的虚拟構造函数，用來創建計算遲步時曜使用的數據類型
//  當p是武曜時，創建5位的TPlanetData
//  當p是文曜時，創建6位的TGenPlanetData
function CreateOuterMoveData(p : Planet; a : array of Integer) : TCompFraction;
// 通分函数
function GenDominator(p : Planet; f : TCompFraction) : TGenPlanetData;
// 將f扩展为七位分数
function ExtPlanetData(p : Planet; f : TCompFraction) : TGenPlanetData;
// 將七位的f的后兩位合並成一位
function Shrink(f : TGenPlanetData) : TGenPlanetData6;
//@+node:sonam.20180328115513.1: ** 類實現
implementation

uses SysUtils;
//@+node:sonam.20180318212744.1: *3* TCompFraction類實現
//@@c
// 構造函數Create有一個參數n，表明要創建分數的位數
constructor TCompFraction.Create(n: Integer);
begin
	SetLength(fData, n);
	SetLength(fWheel, n);
end;

constructor TCompFraction.Create(f: TCompFraction);
Var
    i : Integer;
begin
	SetLength(fData, f.Length());
	SetLength(fWheel, f.Length());
    for i := 1 to f.Length() do
    begin
        data[i] := f.data[i];
        SetWheel(i, f.wheel[i]);
    end;
end;

function TCompFraction.Length: Integer;
begin
	Length := System.Length(fData);
end;

// GetData(i)的參數i是從一開始的下標
function TCompFraction.GetData(i: Integer): Int64;
begin
	result := fData[i-1];
end;

// SetAllData将该分數的每一位都设为参数d
procedure TCompFraction.SetAllData(d: Integer);
Var
	i: Integer;
begin
	for i := 0 to Length-1 do
		fData[i] := d;
end;

// SetData将从高位開始的第i位设为参数d
procedure TCompFraction.SetData(i: Integer; d : Int64);
begin
	fData[i-1] := d;
end;

function TCompFraction.GetWheel(i: Integer): Integer;
begin
	result := fWheel[i-1];
end;

procedure TCompFraction.SetWheel(i, w: Integer);
begin
    fWheel[i-1] := w;
end;

procedure TCompFraction.SetAllWheel(a: array of Integer);
Var
	i : Integer;
begin
	for i := 0 to System.Length(a)-1 do
		fWheel[i] := a[i];
end;

// 當且僅當兩個多位分數的每一個對應位的分子和分母都相等時，才說兩個分數相等
function TCompFraction.Equal(frac: TCompFraction) : Boolean;
Var
	i : Integer;
begin
	i := 1;
	result := true;
	while (result = true) and (i <= Length) do
	begin
		if (data[i] <> frac.data[i]) or (wheel[i] <> frac.wheel[i]) then
			result := false;
		i := i+1;
	end;
end;

function TCompFraction.GreatEqual(frac: TCompFraction) : Boolean;
Var
	i : Integer;
	Ended : Boolean;
begin
    Ended := false;
	result := true;
	i := 1;
	while not Ended and (i <= Length) do
	begin
		if data[i] <> frac.data[i] then
		begin
			Ended := true;
			if data[i] > frac.data[i] then
				result := true
			else
				result := false
		end
        else
            i := i+1;
	end;
end;

procedure TCompFraction.Add(frac: TCompFraction);
Var
	i : Integer;
begin
	for i := 1 to Length do
	begin
		data[i] := data[i] + frac.data[i];
	end;
end;

procedure TCompFraction.Sub(frac: TCompFraction);
Var
	i, j : Integer;
    borrow : Boolean;
begin
	for i := 1 to Length do
	begin
		if (data[i] >= frac.data[i]) then
			data[i] := data[i] - frac.data[i]
		else
		begin
            // 現在不夠減，先借位
			if i <> 1 then
            // 如果不是最高位則向上一位借位
            begin
                j := i-1;
                borrow := true;
                while (j >=1 ) and (borrow) do
                begin
                    if data[j] = 0 then
                        data[j] := data[j] + wheel[j] - 1
                    else
                    begin
                        data[j] := data[j] - 1;
                        borrow := false;
                    end;
                    j := j-1;
                end;
            end;

			data[i] := data[i] + wheel[i] - frac.data[i];
		end;
	end;
end;

procedure TCompFraction.Multiply(frac: TCompFraction);
Var
	i : Integer;
begin
	for i := 1 to Length do
	begin
		data[i] := data[i] * frac.data[i];
	end;
end;

procedure TCompFraction.Multiply(n: Int64);
Var
	i : Integer;
begin
	for i := 1 to Length do
	begin
		data[i] := data[i] * n; // 有可能會溢出
	end;
end;

// Divide(dv, start)的語義是從高位起第start位開始，每一位都除以dv，如果有
// 餘數，就乘以下一位的分母然后再除以dv，如是直到最低位
procedure TCompFraction.Divide(dv: Integer; start: Integer);
Var
	i : Integer;
	remainder : Integer;
begin
	for i := start to Length do
	begin
		remainder := data[i] mod dv;
		data[i] := data[i] div dv;
		if (i <> Length) then
			data[i+1] := remainder * wheel[i+1] + data[i+1];
	end;
end;

// 從最低位開始向上進位
procedure TCompFraction.Calibrate;
Var
	i : Integer;
	result: Integer;	// 除以分母之后的商
begin
	for i := Length downto 1 do
	begin
		result := data[i] div wheel[i];
		data[i] := data[i] mod wheel[i];
		if i <> 1 then	// 如果不是最高一位，就将商加到上一位
			data[i-1] := data[i-1] + result;
	end;
end;

function TCompFraction.Text() : String;
Var
    i : Integer;
begin
    result := '(' + IntToStr(data[1]);
    for i := 2 to Length do
        result := result + ',' + IntToStr(data[i]);
    result := result + ')'; 
end;
//@+node:sonam.20180318203958.1: *3* TWeekData類實現
//@@c
constructor TWeekData.Create(a: array of Integer);
Const
	wkbits = 6;
	wkwheel : array[0..wkbits-1] of Integer = (7,60,60,6,67,707);
Var
	i : Integer;
begin
	inherited Create(wkbits);
	for i := 1 to wkbits do
	begin
		data[i] := a[i-1];
	end;
	SetAllWheel(wkwheel);
end;
//@+node:sonam.20180318204400.1: *3* TSunData類實現
//@@c
constructor TSunData.Create(a: array of Integer);
Const
	sunbits = 5;
	sunwheel : array[0..sunbits-1] of Integer = (27,60,60,6,67);
Var
	i : Integer;
begin
	inherited Create(sunbits);
	for i := 1 to sunbits do
	begin
		data[i] := a[i-1];
	end;
	SetAllWheel(sunwheel);
end;
//@+node:sonam.20180318204411.1: *3* TMoonData類實現
//@@c
constructor TMoonData.Create(a: array of Integer);
Const
	moonbits = 2;
	moonwheel : array[0..moonbits-1] of Integer = (28, 126);
Var
	i : Integer;
begin
	inherited Create(moonbits);
	for i := 1 to moonbits do
	begin
		data[i] := a[i-1];
	end;
	SetAllWheel(moonwheel);
end;
//@+node:sonam.20180318204422.1: *3* TPlanetData類實現
//@@c
constructor TPlanetData.Create(p: Planet; a: array of Integer);
Const
    planetBits = 5;
	CmnWheel : array [0..planetBits-2] of Integer = (27,60,60,6);
Var
	buf : array[0..planetBits-1] of Integer;
	i : Integer;
begin
	inherited Create(planetBits);
	for i := 1 to planetBits do
	begin
		data[i] := a[i-1];
	end;
	for i := 0 to planetBits-2 do
	begin
		buf[i] := CmnWheel[i];
	end;
    buf[planetBits-1] := PlanetWheel[ord(p) - ord(Mars)];
	SetAllWheel(buf);
end;
//@+node:sonam.20180318204442.1: *3* TSunPlanetData類實現
//@@c
constructor TSunPlanetData.Create(a: array of Integer);
Const
    GenPlanetBits = 6;
	Wheels : array[0..GenPlanetbits-1] of Integer = (27,60,60,6,67,2227);    
Var
	i : Integer;
begin
	inherited Create(GenPlanetBits);
	for i := 1 to GenPlanetBits do
	begin
		data[i] := a[i-1];
	end;
	SetAllWheel(Wheels);
end;

function CreateOuterMoveData(p : Planet; a : array of Integer) : TCompFraction;
begin
    if (p = Mars) or (p = Jupiter) or (p = Saturn) then
        result := TPlanetData.Create(p, a)
    else
        result := TSunPlanetData.Create(a);
end;
//@+node:sonam.20180318205748.1: *3* TGenPlanetData類實現
constructor TGenPlanetData.Create(p : Planet; f : TCompFraction);
Var
	a : array of Integer;
    i : Integer;
begin
    SetLength(a, f.Length());
    for i := 1 to f.Length() do
        a[i-1] := f.data[i];
    Create(p, a);
end;

constructor TGenPlanetData.Create(p : Planet; a : array of Integer);
Const
    GenPlanetBits = 7;
	Wheels : array[0..GenPlanetbits-1] of Integer = (27,60,60,6,0,67,2227);    
Var
	i : Integer;
begin
	inherited Create(GenPlanetBits);
	for i := 1 to System.Length(a) do
	begin
		data[i] := a[i-1];
	end;
	SetAllWheel(Wheels);
    SetWheel(5, PlanetWheel[Ord(p)-Ord(Mars)]);
end;

constructor TGenPlanetData6.Create(f : TGenPlanetData);
Const
    LastWheel = 149209;
    GenPlanet6Bits = 6;
Var
    i : Integer;
begin
	inherited Create(GenPlanet6Bits);
    for i := 1 to GenPlanet6Bits-1 do
    begin
        data[i] := f.data[i];
        SetWheel(i, f.wheel[i]);
    end;
    i := GenPlanet6Bits;
    data[i] := f.data[i] * f.wheel[i+1] + f.data[i+1];
    SetWheel(i, LastWheel);
end;
//@+node:sonam.20180318221516.1: *3* 通分
//@+at 五曜的遲行定數和檢步序數的位數和分母皆不盡相同，因爲计算疾行定数时需要相互
// 加減，因此需要對它們進行通分。通分后武曜的檢步序數和文曜的遲行定數變成了七位
// 分數。
// 
// 通分的方法是，將六位分數的倒數第二位乘以最后一位的分母加上最后一位，然后乘
// 以各曜對應的TPlanetData的最后一位的分母，然后連續除以2227和67，其兩個
// 餘數和最后的商就構成了七位分數的最后三位，其第一位的分母即各曜的
// TPlanetData的最后一位的分母，下面兩位的分母分別是67和2227
// 
//@@c
function GenDominator(p : Planet; f : TCompFraction) : TGenPlanetData;
Var
    d : Int64;
begin
    result := TGenPlanetData.Create(p, f);
    d := (f.data[5] * f.wheel[6] + f.data[6]) * result.wheel[5];
    result.data[7] := d mod 2227;
    result.data[6] := d div 2227 mod 67;
    result.data[5] := d div 2227 div 67;
end;

// 將五位或六位的遲行定數變成七位分數，后面補零
function ExtPlanetData(p : Planet; f : TCompFraction) : TGenPlanetData;
begin
    result := TGenPlanetData.Create(p, f);
    result.data[6] := 0;
    result.data[7] := 0;
end;

function Shrink(f : TGenPlanetData) : TGenPlanetData6;
begin
    result := TGenPlanetData6.Create(f);
end;
//@-others

end.
//@-leo
